home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 18 / forthsup / extract.fth < prev    next >
Encoding:
Text File  |  1986-09-18  |  709 b   |  27 lines
  1. : getline ( -- addr len )
  2.    linefeed  word    ( addr )
  3.    count
  4. ;
  5. \ Copy 1 line from the input stream to the output file, returning true if the
  6. \ line starts with ` or the end of the file is reached.
  7. : 1line ( -- end? )
  8.    getline   ( addr end? )
  9.    dup ( addr len len )
  10.    if   \ The line has some characters in it
  11.         dup 2 <= >r  over c@ ascii `  =  r> and     ( addr len f)
  12.     if  \ The line only contains a `
  13.          2drop true
  14.     else
  15.              ofd @ fputs  linefeed ofd @ fputc
  16.              false
  17.     then
  18.    else \ the line is empty     ( addr len )
  19.         2drop  delimiter @ -1  =
  20.    then
  21. ;
  22. : extract  \ filename ( -- )
  23.    writing
  24.    begin   1line   until
  25.    ofd @  close
  26. ;
  27.